perm filename GFTOAM.WEB[X,ALS] blob sn#788943 filedate 1986-06-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% This program is copyright (C) 1984 by D. R. Fuchs.  All rights reserved.
C00005 00003	@* Introduction.
C00013 00004	@* The character set.
C00021 00005	@* Generic font file format.
C00048 00006	@* Input and Output for binary files.
C00057 00007	@* Translation to raster form.
C00071 00008	@* Reading the postamble.
C00077 00009	@* APS Matrix Format.
C00109 00010	@* The main program.
C00115 00011	@* System-dependent changes.
C00116 00012	@* Index.
C00117 ENDMK
C⊗;
% This program is copyright (C) 1984 by D. R. Fuchs.  All rights reserved.
% Version 0 was implemented in May 1984.

% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\noindent\ignorespaces}
\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
\font\ninerm=amr9
\let\mc=\ninerm % medium caps for names like PASCAL
\font\tenss=amss10 % for `The METAFONTbook'
\def\PASCAL{{\mc PASCAL}}
\def\ph{{\mc PASCAL-H}}
\font\logo=manfnt % font used for the METAFONT logo
\def\MF{{\logo META}\-{\logo FONT}}
\def\<#1>{$\langle#1\rangle$}
\def\section{\mathhexbox278}
\let\swap=\leftrightarrow
\def\round{\mathop{\rm round}\nolimits}

\def\(#1){} % this is used to make section names sort themselves better
\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>

\def\title{GFtoAMF}
\def\topofcontents{\null
	\def\titlepage{F} % include headline on the contents page
	\def\rheader{\mainfont\hfil \contentspagenumber}
	\vfill
	\centerline{\titlefont The {\ttitlefont GFtoAMF} processor}
	\vskip 15pt
	\centerline{(Version 1.0, May 1984)}
	\vfill}
\def\botofcontents{\vfill
	\centerline{\hsize 5in\baselineskip9pt
		\vbox{\ninerm\noindent
		`\TeX' is a
		trademark of the American Mathematical Society.}}}
\pageno=\contentspagenumber \advance\pageno by 1
@* Introduction.
The \.{GFtoAMF} utility program reads binary generic-font (``\.{GF}'')
files that are produced by font compilers such as \MF, and converts them
into APS Matrix Format (``\.{AMF}'') files.
This program is based on \.{GFtype}.

The |banner| string defined here should be changed whenever \.{GFtoAMF}
gets modified.

@d banner=='This is GFtoAMF, Version 1.0' {printed when the program starts}
@d resolution==722.909 {pixels per inch}

@ Some of the code below is intended to be used only when debugging this
program.
Such code will not normally be compiled; it is
delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
to people who wish to preserve the purity of English.  For even
more drastic and voluminous output, we use |eebug|.
@↑debugging@>

@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
@f debug==begin
@f gubed==end
@f eebug==begin
@f gubee==end

@ This program is written in standard \PASCAL, except where it is
necessary to use extensions; for example, one extension is to use a
default |case| as in \.{TANGLE}, \.{WEAVE}, etc.  All places where
nonstandard constructions are used have been listed in the index under
``system dependencies.''
@!@↑system dependencies@>

@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@f othercases == else
@f endcases == end

@ The binary input comes from |gf_file|, and the output font is written
on |amf_file|.  Status reporting and error messages appear
on \PASCAL's standard |output| file. The term |print| is used instead of
|write| when this program writes on |output|, so that all such output
could easily be redirected if desired.

@d print(#)==write(#)
@d print_ln(#)==write_ln(#)
@d print_nl==write_ln

@p program GF_to_AMF(@!gf_file,@!amf_file,@!output);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
procedure initialize; {this procedure gets things started properly}
	var i:integer; {loop index for initializations}
	begin print_ln(banner);@/
	@<Set initial values@>@/
	end;

@ If the program has to stop prematurely, it goes to the
`|final_end|'.

@d final_end=9999 {label for the end of it all}

@<Labels...@>=final_end;

@ The following parameters can be changed at compile time to extend or
reduce \.{GFtype}'s capacity.

@<Constants...@>=
@!max_char_no=255; {maximum character number in font}
@!top_pixel=1000; {boundary of pixel image of character}
@!bot_pixel=-500;
@!left_pixel=-300;
@!right_pixel=1800;

@ Here are some macros for common programming idioms.

@d incr(#) == #←#+1 {increase a variable by unity}
@d decr(#) == #←#-1 {decrease a variable by unity}
@d negate(#) == #←-# {change the sign of a variable}
@d do_nothing == {empty statement}

@ If the \.{GF} file is badly malformed, the whole process must be aborted;
\.{GFtoAMF} will give up, after issuing an error message about the symptoms
that were noticed.

Such errors might be discovered inside of subroutines inside of subroutines,
so a procedure called |jump_out| has been introduced. This procedure, which
simply transfers control to the label |final_end| at the end of the program,
contains the only non-local |goto| statement in \.{GFtoAMF}.
@↑system dependencies@>

@d abort(#)==begin print(' ',#); jump_out;
		end
@d bad_gf(#)==abort('Bad GF file: ',#,'!')
@.Bad GF file@>

@p procedure jump_out;
begin goto final_end;
end;

@ We steal the following routine from \MF.

@d unity == @'200000 {$2↑{16}$, represents 1.00000}

@p procedure print_scaled(@!s:integer); {prints scaled real, rounded to five
	digits}
var @!delta:integer; {amount of allowable inaccuracy}
begin if s<0 then
	begin print('-'); negate(s); {print the sign, if negative}
	end;
print(s div unity:1); {print the integer part}
s←10*(s mod unity)+5;
if s≠5 then
	begin delta←10; print('.');
	repeat if delta>unity then
		s←s+@'100000-(delta div 2); {round the final digit}
	print(chr(ord('0')+(s div unity))); s←10*(s mod unity); delta←delta*10;
	until s≤delta;
	end;
end;
@* The character set.
Like all programs written with the  \.{WEB} system, \.{GFtoAMF} can be
used with any character set. But it uses ASCII code internally, because
the programming for portable input-output is easier when a fixed internal
code is used.

The next few sections of \.{GFtoAMF} have therefore been copied from the
analogous ones in the \.{WEB} system routines. They have been considerably
simplified, since \.{GFtoAMF} need not deal with the controversial
ASCII codes less than @'40. If such codes appear in the \.{GF} file,
they will be printed as question marks.

@<Types...@>=
@!ASCII_code=" ".."~"; {a subrange of the integers}

@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
character sets were common, so it did not make provision for lower case
letters. Nowadays, of course, we need to deal with both upper and lower case
alphabets in a convenient way, especially in a program like \.{GFtoAMF}.
So we shall assume that the \PASCAL\ system being used for \.{GFtoAMF}
has a character set containing at least the standard visible characters
of ASCII code (|"!"| through |"~"|).

Some \PASCAL\ compilers use the original name |char| for the data type
associated with the characters in text files, while other \PASCAL s
consider |char| to be a 64-element subrange of a larger data type that has
some other name.  In order to accommodate this difference, we shall use
the name |text_char| to stand for the data type of the characters in the
output file.  We shall also assume that |text_char| consists of
the elements |chr(first_text_char)| through |chr(last_text_char)|,
inclusive. The following definitions should be adjusted if necessary.
@↑system dependencies@>

@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}

@<Types...@>=
@!text_file=packed file of text_char;

@ The \.{GFtoAMF} processor converts between ASCII code and
the user's external character set by means of arrays |xord| and |xchr|
that are analogous to \PASCAL's |ord| and |chr| functions.

@<Globals...@>=
@!xord: array [text_char] of ASCII_code;
	{specifies conversion of input characters}
@!xchr: array [0..255] of text_char;
	{specifies conversion of output characters}

@ Under our assumption that the visible characters of standard ASCII are
all present, the following assignment statements initialize the
|xchr| array properly, without needing any system-dependent changes.

@<Set init...@>=
for i←0 to @'37 do xchr[i]←'?';
xchr[@'40]←' ';
xchr[@'41]←'!';
xchr[@'42]←'"';
xchr[@'43]←'#';
xchr[@'44]←'$';
xchr[@'45]←'%';
xchr[@'46]←'&';
xchr[@'47]←'''';@/
xchr[@'50]←'(';
xchr[@'51]←')';
xchr[@'52]←'*';
xchr[@'53]←'+';
xchr[@'54]←',';
xchr[@'55]←'-';
xchr[@'56]←'.';
xchr[@'57]←'/';@/
xchr[@'60]←'0';
xchr[@'61]←'1';
xchr[@'62]←'2';
xchr[@'63]←'3';
xchr[@'64]←'4';
xchr[@'65]←'5';
xchr[@'66]←'6';
xchr[@'67]←'7';@/
xchr[@'70]←'8';
xchr[@'71]←'9';
xchr[@'72]←':';
xchr[@'73]←';';
xchr[@'74]←'<';
xchr[@'75]←'=';
xchr[@'76]←'>';
xchr[@'77]←'?';@/
xchr[@'100]←'@@';
xchr[@'101]←'A';
xchr[@'102]←'B';
xchr[@'103]←'C';
xchr[@'104]←'D';
xchr[@'105]←'E';
xchr[@'106]←'F';
xchr[@'107]←'G';@/
xchr[@'110]←'H';
xchr[@'111]←'I';
xchr[@'112]←'J';
xchr[@'113]←'K';
xchr[@'114]←'L';
xchr[@'115]←'M';
xchr[@'116]←'N';
xchr[@'117]←'O';@/
xchr[@'120]←'P';
xchr[@'121]←'Q';
xchr[@'122]←'R';
xchr[@'123]←'S';
xchr[@'124]←'T';
xchr[@'125]←'U';
xchr[@'126]←'V';
xchr[@'127]←'W';@/
xchr[@'130]←'X';
xchr[@'131]←'Y';
xchr[@'132]←'Z';
xchr[@'133]←'[';
xchr[@'134]←'\';
xchr[@'135]←']';
xchr[@'136]←'↑';
xchr[@'137]←'_';@/
xchr[@'140]←'`';
xchr[@'141]←'a';
xchr[@'142]←'b';
xchr[@'143]←'c';
xchr[@'144]←'d';
xchr[@'145]←'e';
xchr[@'146]←'f';
xchr[@'147]←'g';@/
xchr[@'150]←'h';
xchr[@'151]←'i';
xchr[@'152]←'j';
xchr[@'153]←'k';
xchr[@'154]←'l';
xchr[@'155]←'m';
xchr[@'156]←'n';
xchr[@'157]←'o';@/
xchr[@'160]←'p';
xchr[@'161]←'q';
xchr[@'162]←'r';
xchr[@'163]←'s';
xchr[@'164]←'t';
xchr[@'165]←'u';
xchr[@'166]←'v';
xchr[@'167]←'w';@/
xchr[@'170]←'x';
xchr[@'171]←'y';
xchr[@'172]←'z';
xchr[@'173]←'{';
xchr[@'174]←'|';
xchr[@'175]←'}';
xchr[@'176]←'~';
for i←@'177 to 255 do xchr[i]←'?';

@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|.

@<Set init...@>=
for i←first_text_char to last_text_char do xord[chr(i)]←@'40;
for i←" " to "~" do xord[xchr[i]]←i;
@* Generic font file format.
The most important output produced by a production run of \MF\ is the
``generic font'' (\.{GF}) file that specifies the bit patterns of the
characters that have been drawn. The term {\sl generic\/} indicates that
this file format doesn't match the conventions of any name-brand manufacturer;
but it is easy to convert \.{GF} files to the special format required by
almost all digital phototypesetting equipment. There's a strong analogy
between the \.{DVI} files written by \TeX\ and the \.{GF} files written
by \MF; and, in fact, the file formats have a lot in common.

A \.{GF} file is a stream of 8-bit bytes that may be
regarded as a series of commands in a machine-like language. The first
byte of each command is the operation code, and this code is followed by
zero or more bytes that provide parameters to the command. The parameters
themselves may consist of several consecutive bytes; for example, the
`|boc|' (beginning of character) command has seven parameters, each of
which is four bytes long. Parameters are usually regarded as nonnegative
integers; but four-byte-long parameters can be either positive or
negative, hence they range in value from $-2↑{31}$ to $2↑{31}-1$.
As in \.{TFM} files, numbers that occupy
more than one byte position appear in BigEndian order,
and negative numbers appear in two's complement notation.

A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
more ``characters,'' followed by a ``postamble.'' The preamble is simply a
|pre| command, with its parameters that introduce the file; this must come
first.  Each ``character'' consists of a |boc| command, followed by any
number of other commands that specify the ``black'' pixels of a character,
followed by an |eoc| command. The characters appear in the order that \MF\
generated them. If we ignore no-op commands (which are allowed between any
two commands in the file), each |eoc| command is immediately followed by a
|boc| command, or by a |post| command; in the latter case, there are no
more characters in the file, and the remaining bytes form the postamble.
Further details about the postamble will be explained later.

Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
quantities that give the location number of some other byte in the file;
the first byte is number~0, then comes number~1, and so on.

@ The \.{GF} format is intended to be both compact and easily interpreted
by a machine. Compactness is achieved by making most of the information
relative instead of absolute. When a \.{GF}-reading program reads the
commands for a character, it keeps track of two quantities: (a)~the current
column number,~|m|; and (b)~the current row number,~|n|.  These are 32-bit
signed integers, although most actual font formats produced from \.{GF}
files will need to curtail this vast range because of practical
limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
n\vert$ to exceed 4096, but the \.{GF} format tries to be more general.)

How do \.{GF}'s row and column numbers correspond to the conventions
of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
view, is considered to be at the lower left corner of the pixel in row~0
and column~0. This point is the intersection of the baseline with the left
edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
region of the plane whose coordinates both lie between 0 and~1. The
pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
coordinates |(x,y)| satisfy |m≤x≤m+1| and |n≤y≤n+1|.  Negative values of
|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
point; negative values of |n| and~|y| correspond to rows of pixels {\sl
below\/} the baseline.

Besides |m| and |n|, there's also a third aspect of the current
state, namely the @!|paint_switch|, which is always either \\{black} or
\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
and blackens the intervening pixels if |paint_switch=black|; then
the |paint_switch| changes to the opposite state. \.{GF}'s commands are
designed so that |m| will never decrease within a row, and |n| will never
increase within a character; hence there is no way to whiten a pixel that
has been blackened.

@ Here is a list of all the commands that may appear in a \.{GF} file. Each
command is specified by its symbolic name (e.g., |boc|), its opcode byte
(e.g., 67), and its parameters (if any). The parameters are followed
by a bracketed number telling how many bytes they occupy; for example,
`|d[2]|' means that parameter |d| is two bytes long.

\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.

\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
These are \\{paint} commands with |d=1| to~63, defined as follows: If
|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
in columns |m| through |m+d-1| inclusive. Then, in any case,
complement the |paint_switch| and advance |m| by~|d|.

\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
value of~|d|; \MF\ uses it to paint when |64≤d<256|.

\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
as~65535.

\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
as $2↑{24}-1$. \MF\ never needs this command, and it is hard to imagine
anybody making practical use of it; surely a more compact encoding will be
desirable when characters can be this large. But the command is there,
anyway, just in case.

\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
|max_n[4]|. Beginning of a character:  Here |c| is the character code, and
|p| points to the previous character beginning (if any) for characters having
this code number modulo 256.  (The pointer |p| is |-1| if there was no
prior character with an equivalent code.) The values of registers |m| and |n|
defined by the instructions that follow for this character must
satisfy |min_m≤m≤max_m| and |min_n≤n≤max_n|.  (The values of |max_m| and
|min_n| need not be the tightest bounds possible.)  When a \.{GF}-reading
program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
initialize the bounds of an array. Then it sets |m←min_m|, |n←max_n|, and
|paint_switch←white|.

\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
The one-byte parameters must be between 0 and 255, inclusive.
\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)

\yskip\hang|eoc| 69. End of character: All pixels blackened so far
constitute the pattern for this character. In particular, a completely
blank character might have |eoc| immediately following |boc|.

\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m←min_m|,
|paint_switch←white|. \ (This finishes one row and begins another,
ready to whiten the leftmost pixel in the new row.)

\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m←min_m|, and set
|paint_switch←white|. This is a way to produce |d| all-white rows.

\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
as 65535.

\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
as $2↑{24}-1$. \MF\ obviously never needs this command.

\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m←min_m|,
|paint_switch←black|. \ (This finishes one row and begins another,
ready to {\sl blacken\/} the leftmost pixel in the new row.)

\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
|new_row_0|, but with |m←min_m+1| through |min_m+165|, respectively.

\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
programs are being used. \MF\ generates \\{xxx} commands when encountering
a \&{special} string; this occurs in the \.{GF} file only between
characters, after the preamble, and before the postamble. However,
\\{xxx} commands might appear anywhere in \.{GF} files generated by other
processors. It is recommended that |x| be a string having the form of a
keyword followed by possible parameters relevant to that keyword.

\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0≤k<65536|.

\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0≤k<@t$2↑{24}$@>|.
\MF\ uses this when sending a \&{special} string whose length exceeds~255.

\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
ridiculously large; |k| mustn't be negative.

\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
result of \&{numspecial} commands; the intent is to provide numeric
parameters to \\{xxx} commands that immediately precede.

\yskip\hang|@!no_op| 244. No operation, do nothing. Any number of |no_op|'s
may occur between \.{GF} commands, but a |no_op| cannot be inserted between
a command and its parameters or between two parameters.

\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
This command will appear only in the postamble, which will be explained shortly.

\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
Same as |char_loc|, except that |dy| is assumed to be zero, and the value
of~|dx| is taken to be |65536*dm|, where |0≤dm<256|.

\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
Beginning of the preamble; this must come at the very beginning of the
file. Parameter |i| is an identifying number for \.{GF} format, currently
130. The other information is merely commentary; it is not given
special interpretation like \\{xxx} commands are. (Note that \\{xxx}
commands may immediately follow the preamble, before the first |boc|.)

\yskip\hang|post| 248. Beginning of the postamble, see below.

\yskip\hang|post_post| 249. Ending of the postamble, see below.

\yskip\noindent Commands 250--255 are undefined at the present time.

@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}

@ Here are the opcodes that \.{GFtoAMF} actually refers to.

@d paint_0=0 {beginning of the \\{paint} commands}
@d paint1=64 {move right a given number of columns, then
	black${}\swap{}$white}
@d boc=67 {beginning of a character}
@d boc1=68 {short form of |boc|}
@d eoc=69 {end of a character}
@d skip0=70 {skip no blank rows}
@d skip1=71 {skip over blank rows}
@d new_row_0=74 {move down one row and then right}
@d xxx1=239 {for \&{special} strings}
@d xxx3=241 {for long \&{special} strings}
@d yyy=243 {for \&{numspecial} numbers}
@d no_op=244 {no operation}
@d char_loc=245 {character locators in the postamble}
@d char_loc0=246 {character locators in the postamble}
@d pre=247 {preamble}
@d post=248 {postamble beginning}
@d post_post=249 {postamble ending}
@d undefined_commands==250,251,252,253,254,255

@ The last character in a \.{GF} file is followed by `|post|'; this command
introduces the postamble, which summarizes important facts that \MF\ has
accumulated. The postamble has the form
$$\vbox{\halign{\hbox{#\hfil}\cr
	|post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
	 |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
	$\langle\,$character locators$\,\rangle$\cr
	|post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
Here |p| is a pointer to the byte following the final |eoc| in the file
(or to the byte following the preamble, if there are no characters);
it can be used to locate the beginning of \\{xxx} commands
that might have preceded the postamble. The |ds| and |cs| parameters
@↑design size@> @↑check sum@>
give the design size and check sum, respectively, which are exactly the
values put into the header of the \.{TFM} file that \MF\ produces (or
would produce) on this run. Parameters |hppp| and |vppp| are the ratios of
pixels per point, horizontally and vertically, expressed as |scaled| integers
(i.e., multiplied by $2↑{16}$); they can be used to correlate the font
with specific device resolutions, magnifications, and ``at sizes.''  Then
come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
registers |m| and~|n| assume in all characters in this \.{GF} file.
(These bounds need not be the best possible; |max_m| and |min_n| may, on the
other hand, be tighter than the similar bounds in |boc| commands. For
example, some character may have |min_n=-100| in its |boc|, but it might
turn out that |n| never gets lower than |-50| in any character; then
|min_n| can have any value |≤-50|. If there are no characters in the file,
it's possible to have |min_m>max_m| and/or |min_n>max_n|.)

@ Character locators are introduced by |char_loc| commands,
which specify a character residue~|c|, character escapements (|dx,dy|),
a character width~|w|, and a pointer~|p|
to the beginning of that character. (If two or more characters have the
same code~|c| modulo 256, only the last will be indicated; the others can be
located by following backpointers. Characters whose codes differ by a
multiple of 256 are assumed to share the same font metric information,
hence the \.{TFM} file contains only residues of character codes modulo~256.
This convention is intended for oriental languages, when there are many
character shapes but few distinct widths.)
@↑oriental characters@>@↑Chinese characters@>@↑Japanese characters@>

The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
and \&{chardy} parameters; they are in units of |scaled| pixels;
i.e., |dx| is in horizontal pixel units times $2↑{16}$, and |dy| is in
vertical pixel units times $2↑{16}$.  This is the intended amount of
displacement after typesetting the character; for \.{DVI} files, |dy|
should be zero, but other document file formats allow nonzero vertical
escapement.

The character width~|w| duplicates the information in the \.{TFM} file; it
is a |fix_word| value relative to the design size, and it should be
independent of magnification.

The backpointer |p| points to the character's |boc|, or to the first of
a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
immediately precede the |boc|, if such commands exist; such ``special''
commands essentially belong to the characters, while the special commands
after the final character belong to the postamble (i.e., to the font
as a whole). This convention about |p| applies also to the backpointers
in |boc| commands, even though it wasn't explained in the description
of~|boc|. @↑backpointers@>

Pointer |p| might be |-1| if the character exists in the \.{TFM} file
but not in the \.{GF} file. This unusual situation can arise in \MF\ output
if the user had |proofing<0| when the character was being shipped out,
but then made |proofing≥0| in order to get a \.{GF} file.

@ The last part of the postamble, following the |post_post| byte that
signifies the end of the character locators, contains |q|, a pointer to the
|post| command that started the postamble.  An identification byte, |i|,
comes next; this currently equals~130, as in the preamble.

The |i| byte is followed by four or more bytes that are all equal to
the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
these trailing bytes, until the total length of the file is a multiple of
four bytes, since this works out best on machines that pack four bytes per
word; but any number of 223's is allowed, as long as there are at least four
of them. In effect, 223 is a sort of signature that is added at the very end.
@↑Fuchs, David Raymond@>

This curious way to finish off a \.{GF} file makes it feasible for
\.{GF}-reading programs to find the postamble first, on most computers,
even though \MF\ wants to write the postamble last. Most operating
systems permit random access to individual words or bytes of a file, so
the \.{GF} reader can start at the end and skip backwards over the 223's
until finding the identification byte. Then it can back up four bytes, read
|q|, and move to byte |q| of the file. This byte should, of course,
contain the value 248 (|post|); now the postamble can be read, so the
\.{GF} reader can discover all the information needed for individual characters.

Unfortunately, however, standard \PASCAL\ does not include the ability to
@↑system dependencies@>
access a random position in a file, or even to determine the length of a file.
Almost all systems nowadays provide the necessary capabilities, so \.{GF}
format has been designed to work most efficiently with modern operating systems.
Indeed, \.{GFtoAMF} insists on being able to read the postamble first, because
it needs the device width information found there in order to encode characters.
@* Input and Output for binary files.
We have seen that a \.{GF} file is a sequence of 8-bit bytes. The bytes
appear physically in what is called a `|packed file of 0..255|'
in \PASCAL\ lingo.

Packing is system dependent, and many \PASCAL\ systems fail to implement
such files in a sensible way (at least, from the viewpoint of producing
good production software).  For example, some systems treat all
byte-oriented files as text, looking for end-of-line marks and such
things. Therefore some system-dependent code is often needed to deal with
binary files, even though most of the program in this section of
\.{GFtoAMF} is written in standard \PASCAL.
@↑system dependencies@>

We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
even if such simplicity is sometimes unrealistic.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}

@ The program deals with two binary file variables: |gf_file| is the
input file that we are translating into APS format, to be written
on |amf_file|.

@<Glob...@>=
@!gf_file:byte_file; {the stuff we are \.{GFtoAMF}ing}
@!amf_file:byte_file; {the stuff we have \.{GFtoAMF}ed}

@ To prepare the |gf_file| for input, we |reset| it.

@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file);
cur_loc←0;
end;

@ To prepare the |amf_file| for output, we |rewrite| it.

@p procedure open_amf_file; {prepares to write packed bytes in |amf_file|}
begin rewrite(amf_file);
end;

@ If you looked carefully at the preceding code, you probably asked,
``What is |cur_loc|?'' Good question. It's a global variable that holds
the number of the byte about to be read next from |gf_file|.  Likewise,
|amf_byte| holds the number of the byte about to be written next
into |amf_file|.

@<Glob...@>=
@!cur_loc:integer; {where we are about to look, in |gf_file|}
@!amf_byte_no:integer; {where we are about to write, in |amf_file|}

@ We shall use a set of simple functions to read the next byte or
bytes from |gf_file|. There are seven possibilities, each of which is
treated as a separate function in order to minimize the overhead for
subroutine calls.
@↑system dependencies@>

@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(gf_file) then get_byte←0
else	begin read(gf_file,b); incr(cur_loc); get_byte←b;
	end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read(gf_file,b); incr(cur_loc);
if b<128 then signed_byte←b @+ else signed_byte←b-256;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_loc←cur_loc+2;
get_two_bytes←a*256+b;
end;
@#
function signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_loc←cur_loc+2;
if a<128 then signed_pair←a*256+b
else signed_pair←(a-256)*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_loc←cur_loc+3;
get_three_bytes←(a*256+b)*256+c;
end;
@#
function signed_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_loc←cur_loc+3;
if a<128 then signed_trio←(a*256+b)*256+c
else signed_trio←((a-256)*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
cur_loc←cur_loc+4;
if a<128 then signed_quad←((a*256+b)*256+c)*256+d
else signed_quad←(((a-256)*256+b)*256+c)*256+d;
end;

@ Most info in the |amf_file| comes in words, but we have to write it
as bytes and halfwords occasionally.

@d amf_byte(#)==begin write(amf_file,#); incr(amf_byte_no); end

@p procedure amf_halfword(@!w:integer);
begin
if w<0 then w←w+@"10000;
amf_byte(w div @"100);
amf_byte(w mod @"100);
end;
@#
procedure amf_word(@!w:integer);
begin
if w>0 then amf_byte(w div @"1000000)
else begin
	w:=w+@"40000000;
	w:=w+@"40000000;
	amf_byte((w div @"1000000) + 128);
	end;
amf_byte((w div @"10000) mod @"100);
amf_byte((w div @"100) mod @"100);
amf_byte(w mod @"100);
end;

@ Finally we come to the routines that are used for random access of the
|gf_file|. The driver program below needs two such routines: |gf_length| should
compute the total number of bytes in |gf_file|, possibly also
causing |eof(gf_file)| to be true; and |move_to_byte(n)|
should position |gf_file| so that the next |get_byte| will read byte |n|,
starting with |n=0| for the first byte in the file.
@↑system dependencies@>

Such routines are, of course, highly system dependent. They are implemented
here in terms of two assumed system routines called |set_pos| and |cur_pos|.
The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
negative or larger than the total number of items in |f|; in the latter
case, |set_pos(f,n)| moves to the end of file |f|.
The call |cur_pos(f)| gives the total number of items in |f|, if
|eof(f)| is true; we use |cur_pos| only in such a situation.

@p function gf_length:integer;
begin set_pos(gf_file,-1); gf_length←cur_pos(gf_file);
end;
@#
procedure move_to_byte(n:integer);
begin set_pos(gf_file,n); cur_loc←n;
end;
@* Translation to raster form.
The main work of \.{GFtoAMF} is accomplished by the |do_char| procedure,
which produces the output for an entire character, assuming that the |boc|
command for that character has already been processed. This procedure
works in two parts, the first of which is
essentially an interpretive routine that reads and acts on the \.{GF}
commands by writing into an array of pixels, and the second is a
routine which converts that array into a run-length format.

@ The definition of \.{GF} files refers to two registers,
$(m,n)$, which hold integer row and column numbers.  We also
need to remember |paint_switch|, who's value is either |black|
or |white|.

@<Types...@>=
@!x_coord=left_pixel..right_pixel;
@!y_coord=bot_pixel..top_pixel;
{BUG FIXME ??? off by one}

@ @<Glob...@>=
@!m:x_coord;
@!n:y_coord; {current state values}
@!paint_switch: pixel;

@ We'll need a big array of pixels to hold the character image.  Each
pixel should be represented as a single bit in order to save space.
Different systems may prefer the following definitions, while others
may do better using the |boolean| type and constants.
@↑system dependencies@>

@d white=0 {could also be |false|}
@d black=1 {could also be |true|}
@d complement(#)==if #=black then #←white@+else #←black
	{could also be |paint_switch←not paint_switch|}

@<Types...@>=
@!pixel=white..black; {could also be |boolean|}

@ In order to allow different systems to change the |image| array from
row-major to column-major (or vice versa) easily, or to transpose it top
and bottom or left and right, we declare and access it as follows.
@↑system dependencies@>

@d image==image_array[n,m]

@<Glob...@>=
@!image_array: packed array [y_coord,x_coord] of pixel;

@ Maybe there's a faster way to do this on your system.  Note that the
only part of the |image_array| that we clear is the part that the current
character may use.  Thus, the rest of this program may not look outside
the area delimited by |[m,n]=[min_n..max_n,min_m..max_m]| and expect to
see anything but junk
@↑system dependencies@>

@<Clear the image@>=
begin
n:=min_n;
while n≤max_n do begin
	m←min_m;
	while m≤max_m do begin
		image←white;
		incr(m);
		end;
	incr(n);
	end;
end

@ @<Print the image@>=
begin
n:=max_n;
while (n≥min_n)∧(n≥max_n-80) do begin
	m←min_m;
	while (m≤max_m) ∧ (m≤min_m+78) do begin
		if image=white then print(' ')@+else print('*');
		incr(m);
		end;
	print_ln(' ');
	decr(n);
	end;
end

@ Let's keep track of how many characters are in the font.

@<Glob...@>=
@!character_code: integer; {current character number}
@!total_chars:integer; {the total number of characters seen so far}

@ @<Set init...@>=
total_chars←0;

@ Before we get into the details of |do_char|, it is convenient to
consider a simpler routine that computes the first parameter of each
opcode.

@d four_cases(#)==#,#+1,#+2,#+3
@d eight_cases(#)==four_cases(#),four_cases(#+4)
@d nine_cases(#)==eight_cases(#),#+8
@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
@d eighteen_cases(#)==nine_cases(#),nine_cases(#+9)
@d nineteen_cases(#)==nine_cases(#),nine_cases(#+9),#+18
@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
@d eighty_two_cases(#)==sixty_four_cases(#),eighteen_cases(#+64)
@d eighty_three_cases(#)==sixty_four_cases(#),nineteen_cases(#+64)
@d one_sixty_five_cases(#)==eighty_three_cases(#),eighty_two_cases(#+83)

@p function first_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(paint_0): first_par←o-paint_0;
paint1,skip1,char_loc,char_loc0,xxx1: first_par←get_byte;
paint1+1,skip1+1,xxx1+1: first_par←get_two_bytes;
paint1+2,skip1+2,xxx1+2: first_par←get_three_bytes;
xxx1+3,yyy: first_par←signed_quad;
skip0,no_op,boc,boc1,eoc,pre,post,post_post,undefined_commands: first_par←0;
one_sixty_five_cases(new_row_0): first_par←o-new_row_0;
end;
end;

@ Strictly speaking, the |do_char| procedure is really a function with
side effects, not a `\&{procedure}'; it returns the value |false| if
\.{GFtoAMF} should be aborted because of some unusual happening. The
subroutine is organized as a typical interpreter, with a multiway branch
on the command code.

@p
@<Subroutines for encoding characters@>
@#
function do_char:boolean;
label 1,2,3,4,9997,9998,9999;
var o:eight_bits; {operation code of the current command}
@!p,@!q:integer; {parameters of the current command}
begin {we've already scanned the |boc|}
do_char←true;
while true do @<Translate the next command in the \.{GF} file;
		|goto 9999| if it was |eoc|;
		|goto 9998| if premature termination is needed@>;
9998: print_ln('!'); do_char←false; goto 9997;
9999:
@<Remove white rows and columns@>;
@<Encode the character@>;
9997: end;

@ This is the main command loop.

@d error(#)==begin print(a:1,': ! ',#); print_nl; end

@<Translate the next command...@>=
begin a←cur_loc;
o←get_byte; p←first_par(o);
if eof(gf_file) then bad_gf('the file ended prematurely');
@.the file ended prematurely@>
@<Translate command |o|@>;
end

@ The multiway switch in |first_par|, above, was organized by the length
of each command; the one in |do_char| is organized by the semantics.

@<Translate command...@>=
if o≤paint1+3 then @<Translate a |paint| command@>
else case o of
	one_sixty_five_cases(new_row_0): @<Translate a |new_row| command@>;
	four_cases(skip0): @<Translate a |skip| command@>;
	@t\4@>@<Cases for commands |no_op|, |pre|, |post|, |post_post|, |boc|,
		|boc1|, and |eoc|@>@;
	four_cases(xxx1): @<Translate an |xxx| command@>;
	yyy: @<Translate a |yyy| command@>;
	othercases error('undefined command ',o:1,'!')
@.undefined command@>
	endcases

@ @<Cases for commands |no_op|...@>=
no_op: do_nothing;
pre: begin error('preamble command within a page!'); goto 9998;
	end;
@.preamble command within a page@>
post,post_post: begin error('postamble command within a page!'); goto 9998;
@.postamble command within a page@>
	end;
boc,boc1: begin error('boc occurred before eoc'); goto 9998;
@.boc occurred before eoc@>
	end;
eoc: goto 9999;

@ @<Translate an |xxx| command@>=
begin bad_char←false;
while p>0 do begin
	q←get_byte;
	if (q<" ")∨(q>"~") then bad_char←true;
	decr(p);
	end;
if bad_char then error('non-ASCII character in xxx command!');
@.non-ASCII character...@>
end

@ @<Translate a |yyy| command@>=
do_nothing

@ @<Translate a |paint| command@>=
begin
if m+p>right_pixel then
	begin
	if m≤right_pixel then {give error message only once}
		error('character extends too far to the right for me');
@.character extends...@>
	m←m+p;
	end
else while p>0 do begin
	image←paint_switch;
	incr(m);
	decr(p);
	end;
complement(paint_switch);
end

@ @<Translate a |new_row| command@>=
begin
decr(n);
m←min_m+p;
paint_switch←black;
end

@ @<Translate a |skip| command@>=
begin
n←n-(p+1);
m←min_m;
paint_switch←white;
end

@ Note that \.{GF} format does not guarantee that |max_m| and |max_n| are
as small as they might be (they're sure to be big enough, though).  Likewise,
|min_m| and |min_n| might be smaller than they might be.  Here we set the
bounds as tightly as possible.

@d no_black==(min_n>max_n)

@<Remove white rows and columns@>=
@!debug
print_nl;
print_ln('before: minm=',min_m:1,' maxm=',max_m:1,
	' minn=',min_n:1,' maxn=',max_n:1);
gubed@/
n:=min_n;
while n≤max_n do begin
	m:=min_m;
	while m<=max_m do begin
		if image=black then goto 1;
		incr(m);
		end;
	incr(n);
	min_n←n; {blank row at bottom now gone}
	end;
1:
if no_black then begin
	min_m←max_m+1;
	goto 4; {why bother?}
	end;
n:=max_n;
while n>min_n do begin
	m:=min_m;
	while m<=max_m do begin
		if image=black then goto 2;
		incr(m);
		end;
	decr(n);
	max_n←n; {blank row at top now gone}
	end;
2:
m:=min_m;
while m<max_m do begin
	n:=min_n;
	while n<=max_n do begin
		if image=black then goto 3;
		incr(n);
		end;
	incr(m);
	min_m←m; {blank column at left now gone}
	end;
3:
m:=max_m;
while m>min_m do begin
	n:=min_n;
	while n<=max_n do begin
		if image=black then goto 4;
		incr(n);
		end;
	decr(m);
	max_m←m; {blank column at right now gone}
	end;
4:
cols←max_m-min_m+1;
rows←max_n-min_n+1;
@!debug
print_ln('after : minm=',min_m:1,' maxm=',max_m:1,
	' minn=',min_n:1,' maxn=',max_n:1);
print_ln('cols=',cols:1,' rows=',rows:1);
gubed

@ While we were at it, we also snuck in a computation of how many
rows and columns the bounding box is.

@<Glob...@>=
@!cols,@!rows: integer; {columns and rows of pixels}
@* Reading the postamble.
Now imagine that we are reading the \.{GF} file and positioned just
after the |post| command. That, in fact, is the situation,
when the following part of \.{GFtoAMF} is called upon to read, translate,
and check the rest of the postamble.

@p procedure read_postamble;
var k:integer; {loop index}
@!p,@!q,@!m,@!c:integer; {general purpose registers}
begin post_loc←cur_loc-1;
print_ln('Postamble starts at byte ',post_loc:1,'.');
@.Postamble starts at byte n@>
p←signed_quad;
design_size←signed_quad; check_sum←signed_quad;@/
print('design size = ',design_size:1,' (');
print_scaled(design_size div 16); print_ln(')');
print_ln('check sum = ',check_sum:1);@/
hppp←signed_quad; vppp←signed_quad;@/
print('hppp = ',hppp:1,' ('); print_scaled(hppp); print_ln(')');
print('vppp = ',vppp:1,' ('); print_scaled(vppp); print_ln(')');
magnification←hppp/(65536.0*resolution/72.27);
amf_mag←round(1000*magnification);
print_ln('mag = ',amf_mag:1);
min_m←signed_quad; max_m←signed_quad;
min_n←signed_quad; max_n←signed_quad;@/
print_ln('min m = ',min_m:1,', max m = ',max_m:1);@/
print_ln('min n = ',min_n:1,', max n = ',max_n:1);@/
@<Process the character locations in the postamble@>;
@<Make sure that the end of the file is well-formed@>;
end;

@ Here are is the main information we glean from the postamble.

@<Glob...@>=
@!design_size: integer;
@!min_m, @!max_m, @!min_n, @!max_n: integer;
@!hppp, @!vppp: integer;
@!check_sum: integer;
@!post_loc: integer;
@!magnification: real;
@!tfm_width: array [0..max_char_no] of integer;
@!dev_x, @!dev_y: array [0..max_char_no] of integer;

@ When we get to the present code, the |post_post| command has
just been read.

@<Make sure that the end of the file is well-formed@>=
if k≠post_post then
	error('should be postpost!');
@.should be postpost@>
q←signed_quad;
if q≠post_loc then
	error('postamble pointer should be ',post_loc:1,' not ',q:1);
@.postamble pointer should be...@>
m←get_byte;
if m≠gf_id_byte then error('identification byte should be ',gf_id_byte:1);
@.identification byte should be n@>
k←cur_loc; m←223;
while (m=223)∧ not eof(gf_file) do m←get_byte;
if not eof(gf_file) then bad_gf('signature in byte ',cur_loc-1:1,
@.signature...should be...@>
		' should be 223')
else if cur_loc<k+4 then
	error('not enough signature bytes at end of file');
@.not enough signature bytes...@>

@ @<Process the character locations...@>=
repeat k←get_byte;
if k=char_loc then begin
	c←first_par(k);
	if c>max_char_no then abort('Character number too large');
	dev_x[c]←signed_quad div 65536;
	dev_y[c]←signed_quad div 65536;
	tfm_width[c]←signed_quad;
	p←signed_quad;
	k←no_op;
	end
else if k=char_loc0 then begin
	c←first_par(k);
	if c>max_char_no then abort('Character number too large');
	dev_x[c]←get_byte;
	tfm_width[c]←signed_quad;
	p←signed_quad;
	k←no_op;
	end;
until k≠no_op;

@ This routines is brought into play in order to read the postamble first.

@p procedure find_postamble;
var q,@!k: integer;
begin
post_loc←gf_length-4;
repeat if post_loc=0 then bad_gf('all 223s');
@.all 223s@>
move_to_byte(post_loc); k←get_byte; decr(post_loc);
until k≠223;
if k≠gf_id_byte then bad_gf('ID byte is ',k:1);
@.ID byte is wrong@>
move_to_byte(post_loc-3); q←signed_quad;
if (q<0)∨(q>post_loc-3) then
	bad_gf('post pointer ',q:1,' at byte ',post_loc-3:1);
@.post pointer is wrong@>
move_to_byte(q); k←get_byte;
if k≠post then bad_gf('byte ',q:1,' is not post');
@.byte n is not post@>
end;
@* APS Matrix Format.

{??? documentation here screwey, and somewhat wrong!!!}

All words of .AMF files are in 32-bit format, with the four low-order
bits zero on 36-bit machines.

The file contains the encoded font information for the individual
sub-glyphs; this information is used by DVIAPS to decode DVI files
that refer to these fonts.

The first word of the AMF file (word number zero) is a copy of the AMF
ID (see below).  Next come a bunch of "sub-glyph descriptors" and
"sub-glyph data" items, and a "directory", in no particular order.
These will all be explained below.  Finally, the file ends with seven
special words.

The first special word is "BC", the number of the lowest-numbered
character in the font (just like in the TFM file).

The second special word, "EC", is the highest-numbered character.  So,
the number of characters in a font is NC = EC-BC+1.

Third is the checksum, which should match the checksum in any .DVI
file that refers to this font (otherwise TEX prepared the .DVI file
under the wrong assumptions). However, if this word is zero, no
validity check will be made.

Fourth is an integer representing 1000 times the magnification factor
at which this font was produced. The character widths have not been
inflated by this factor, which should match the maginification factor
that is part of the AMF font file name.

Fifth comes a word containing the font's designsize (just as in the
TFM file, in units of $2↑(-20)$ unmagnified points).

Sixth is the directory pointer, which points to the word number of the
first word of the directory.  See below for a description of the
directory.

Seventh (the final word in the AMF file) is the AMF ID word, which is
currently 175 (decimal, which is AF in hex).

The directory is 2*NC words long.  The first NC words contain the
address of the first "Sub-Glyph Descriptor" of each character.  A
value of zero means that the character is all white and has zero
width. An all-white character with non-zero width has a Sub-Glyph
which is a null matrix with correct A and C values.

The second NC words in the directory contain the character widths,
exactly as in the .TFM file, i.e., as signed 32-bit numbers in units
of $2↑(-20)$ ems.  Note that a character might have nonzero width even
though it has no sub-glyphs, and it may have zero width even though it
has many sub-glyphs.  The special value |@"80000000| flags a non-existent
character (one that isn't in the font at all).

Actually, there is one more word in front of the directory, which may
pointer to a fake sub-glyph decsriptor that contains ``default''
information about the font (or it may have a zero).  This information
is not used by DVIAPS, but is simply an aid in recreating a PL file
from TFM and AMF files.

Sub-glyph descriptors describe a whole character, or part of a
character (in the case of a large character which the machine can't
deal with in a single part).  Each Sub-Glyph Descriptor is 16 words
long.  Its fields are:

	0) Next Sub-Glyph word pointer
	1) Device Width of the character in fixes
	2) Bounding Box height
	3) Bounding Box width
	4) X-offset in fixes
	5) Y-offset in fixes
	6) X-magnification in fixes
	7) Y-magnification in fixes
	8) Device Font number
	9) Device Character number
	10) Slant parameter
	11) Bits parameter
	12) Character Data Beginning Byte Pointer
	13) Character Date Byte Count
	14) Unused; set to zero
	15) Unused; set to zero

Note that if you start with the sub-glyph pointed to by the directory,
and follow the address field to the next sub-glyph, and so on till you
hit a zero, you will have looked at all the sub-glyphs that compose
the character.

[More explanation of the fields should go here]

@d amf_id=175 {current version of \.{AMF} format}

@ @<Glob...@>=
@!subglyph_ptr: array [0..max_char_no] of integer;
@!bc,ec:integer;
@!amf_dir_ptr:integer;
@!amf_mag: integer;

@ @<Set init...@>=
bc←max_char_no+1; ec←-1;
for i←0 to max_char_no do begin
	subglyph_ptr[i]←0; {marks nonexistant character}
	tfm_width[i]←0;
	dev_x[i]←0;
	dev_y[i]←0;
	end;

@ @<Start up the |amf_file|@>=
amf_byte_no←0;
amf_word(amf_id);
@!debug
print_ln('Start of AMF info');
gubed

@ @<Finish off the |amf_file|@>=
amf_word(0); {no `default' information}
if (amf_byte_no mod 4)<>0 then abort('This can''t happen: alignment');
amf_dir_ptr←amf_byte_no div 4;
for character_code←bc to ec do amf_word(subglyph_ptr[character_code]);
for character_code←bc to ec do amf_word(tfm_width[character_code]);
amf_word(bc); amf_word(ec);
amf_word(check_sum);
amf_word(amf_mag);
amf_word(design_size);
amf_word(amf_dir_ptr);
amf_word(amf_id);
@!debug
print_ln('End of AMF info');
gubed

@ @<Encode the character@>=
if subglyph_ptr[character_code]≠0 then error('Duplicate character');
subglyph_ptr[character_code]←encode_char;

@ The procedure |encode_char| writes out information to the |amf_file|
as it goes, and returns a pointer to the beginning of that information.
Before we see how it does its work, let's make a few subroutines.

Much of a character's encoding is in 2-bit ``nibbles''  while some of
it somes in bytes.  The actual APS hardware works in bytes, and it has
a one-byte buffer that holds for nibbles.  Whenever it runs out of
nibbles, the APS pulls the next byte out of the stream and puts it in
the nibble buffer.  Thus, to write an encoded character, we have to
keep a single byte buffer for nibbles, and a queue of bytes waiting
to go after the current nibble buffer when it's full and ready to
be written out.

@<Glob...@>=
@!nibble: 0..@"1FF; {|@"100| bit on means buffer full}
@!byte_queue: array [1..255] of eight_bits;
@!byte_count: 0..255; {number of bytes waiting in |byte_queue|}

@ Here's how the queueing works.  The |nibble| variable gets shifted
left 2 bits for each new nibble, so when the sentinal bit reaches
the |@"100| position, we know there are four nibbles in there
waiting to be let out.

@d enq_byte(#)==begin
		incr(byte_count);
		byte_queue[byte_count]←#;
		end
@d enq_nibble(#)==begin
		if nibble>=@"100 then dequeue;
		nibble←nibble*4+#;
		end

@<Subroutines...@>=
procedure dequeue;
var i:1..255;
begin
amf_byte(nibble-@"100);
if byte_count>0 then for i←1 to byte_count do amf_byte(byte_queue[i]);
nibble←1; byte_count←0;
end;

@ @<Queue initialization@>=
nibble←1; byte_count←0;

@ Now some low level nitty-gritty for looking at the |image| array.
The APS works with vertical run-length information, so we'll need
a subroutine or two to psych out this sort of information.  Actually,
the run-length information is in the form of `start/stop' values,
telling where in a column of pixels the beam is to turn off and on.
In case we have to deal with characters that are taller than the
hardware can deal with, we also use |part_bot| and |part_top| to
limit the rows we are considering.  If we want the |y| value of
the pixle at |part_bot| to be other than |part_bot| when put in
the |start_stop_vals| array, the caller is responsible for setting
|n_offset| non-zero.

@<Glob...@>=
@!start_stop_vals, @!old_start_stop_vals:
	array [1..126] of bot_pixel..top_pixel;
{BUG FIXME ??? off by one}
@!num_start_stops, @!old_num_start_stops:
	0..126; {number of values in |start_stop_vals|}
@!num_runs: 0..63; {half of |num_start_stops|}
@!part_bot, @!part_top: y_coord; {subrange we're looking at}
@!n_offset: integer; {how far down is |part_bot| from hardware |y=0|}

@ That leaves us able to scan a column and fill in |num_start_stops| and
the |start_stop_vals| array.

@<Subroutines...@>=
procedure get_start_stop_vals;
	{assumes |m|, |n_offset|, |part_bot| and |part_top| set up}
var color: pixel; {color we're looking for next}
begin
num_start_stops←0; color←black;
n←part_bot;
{??? speed up with white boundary???}
while n≤part_top do begin
	if image=color then begin
		incr(num_start_stops);
		start_stop_vals[num_start_stops]←n+n_offset;
		complement(color);
		end;
	incr(n);
	end;
if color=white then begin {black runs to the top}
	incr(num_start_stops);
	start_stop_vals[num_start_stops]←n+n_offset;
	end;
num_runs←num_start_stops div 2;
{assert |not odd(num_start_stops)|}
end;
@#
procedure print_start_stops;
var i:integer;
begin
print('start/stop=');
for i←1 to num_start_stops do print(' ',start_stop_vals[i]:1);
print_nl;
end;

@ We're building our way up to the point where we can encode a number of
columns in a row.  It turns out that there is a compact encoding if a
number of identical columns occur in a row, so let's keep track of how
many identical rows we see.  We'll also have to keep track of the
start/stop values of the row that's been repeating, or we'll lose that
information when a new row appears; that's what |old_start_stop_vals| and
|old_num_start_stops| (above) were for.  The difference between two
columns that have the same number of segments, but different
|start_stop_vals| is kept in |direction| and |delta|.

@d updown==pixel
@d up==black
@d down==white
@d reverse_direction(#)==complement(#)

@<Glob...@>=
@!repeat_count: integer; {number of identical sequential columns seen}
@!direction: array [1..129] of updown;
@!delta: array [1..129] of integer;

@ Here's the routine that is called when a number of identical rows
has been seen, but the new row is different.  We have to tell the
hardware to repeat the column that it just did (the first of the
identical ones) |repeat_count| times.  It turns out that sometimes
the `compact' encoding is not optimal, in which case we use the
straight-forward encoding.

@d ones_complement(#)==(@"FF-(#))
@d twos_complement(#)==(@"100-(#))

@<Subroutines...@>=
procedure done_repeating; {only called when |repeat_count>0|}
var nibs: integer; {help calculate number of nibbles that various encoding
	alternatives use}
begin
@!eebug
print_ln('repeat ',repeat_count:1);
gubee@/
nibs←repeat_count*old_num_start_stops; {number of nibbles needed to encode
	the straightforward way}
if nibs≥7 then begin {use the shortcut}
	while repeat_count>0 do begin
		enq_nibble(3); enq_nibble(3); enq_nibble(2); {repeat instruction}
		if repeat_count<255 then nibs←repeat_count else nibs←255;
		enq_byte(ones_complement(nibs));
		repeat_count←repeat_count-nibs;
		end;
	end
else if nibs>0 then while nibs>0 do begin enq_nibble(0); decr(nibs); end
else begin {blank columns are special}
	while repeat_count>0 do begin
		enq_nibble(3); enq_nibble(3); enq_nibble(1); {skip instruction}
		enq_byte(0);
		if repeat_count<127 then nibs←repeat_count else nibs←127;
		enq_byte(ones_complement(nibs));
		repeat_count←repeat_count-nibs;
		end;
	end;
repeat_count←0; {for next time around}
end;

@ Now we're ready for the routine that takes an entire horizontal swath of
a character and puts out its encoding to the \.{AMF} output.  This is the
only place we call |get_start_stop_vals|, so of course we expect |x|,
|n_offset|, |part_bot| and |part_top| to be set up, but there are a few
new ones, too.  They are |bloexp|, |vspots|, |aval|, and |cval|, the
so-called exponent of the character depth, the character height, and the
left and right side bearing values for the character.

@<Glob...@>=
@!bloexp: integer; {space below baseline}
@!vspots: integer; {amount of vertical space used}
@!aval, @!cval: integer; {side bearings}

@ Finally, here's how to encode a whole subglyph.

@d next_column=1

@<Subroutines...@>=
procedure do_nibbles;
label next_column;
var aval_extra:integer; {white space at left of subglyph}
@!i:integer;
@!the_same: boolean; {this column the same as last?}
@!movement: integer; {temporary for |delta[i]|}
begin
m←min_m;
@<Queue initialization@>;
@<Get the first column, making sure to skip blanks@>;
@<Start up the encoding@>;
repeat_count←0;
while m<max_m do @<Do the next column@>;
@<Finish off the encoding@>;
end;

@ @<Get the first column, making sure to skip blanks@>=
get_start_stop_vals; {first column}
aval_extra←0;
while num_start_stops=0 do begin
	incr(aval_extra);
	incr(m);
	get_start_stop_vals;
	end;
@!debug
print_ln('avalextra=',aval_extra:1);
print('initial '); print_start_stops;
gubed

@ @<Start up the encoding@>=
@!debug
print_ln('Start matrix');
gubed@/
amf_byte(twos_complement(num_runs));
amf_halfword(aval+2*aval_extra);
amf_byte(bloexp);
amf_byte(ones_complement(vspots+2)); {hardware hack?}
for i←1 to num_start_stops do
	amf_byte(ones_complement(start_stop_vals[i]));
if num_start_stops≤8 then
	for i←1 to num_start_stops do begin
		old_start_stop_vals[i]←start_stop_vals[i];
		direction[i]←down;
		end

@ @<Finish off the encoding@>=
if repeat_count>0 then done_repeating; {if last column(s) repeated}
enq_nibble(3); enq_nibble(3); enq_nibble(1); enq_byte(twos_complement(1));
enq_byte(ones_complement(vspots+3)); enq_byte(ones_complement(vspots+4));
	{garbage}
enq_nibble(3); enq_nibble(3); enq_nibble(3); enq_nibble(3); {end matrix}
enq_nibble(0); enq_nibble(0); enq_nibble(0); enq_nibble(0);
	{force out buffer, exactly}
amf_halfword(cval-2); {correct for garbage}
@!debug
print_nl;
print_ln('End matrix');
gubed

@ @<Do the next column@>=
begin
incr(m); old_num_start_stops←num_start_stops;
get_start_stop_vals;
@!eebug
print_start_stops;
gubee@/
if num_start_stops>8 then @<Do gross case and |goto next_column|@>;
if num_start_stops≠old_num_start_stops then
	@<Set up for a new number of segments and |goto next_column|@>;
@<Calculate |delta|, |direction| and |the_same|@>;
if the_same then begin incr(repeat_count); goto next_column; end;
@<Do the common case, where the segments just move a little@>;
next_column:
end;

@ Here we have too many start/stops for the hardware to handle gracefully.

@<Do gross case and |goto next_column|@>=
begin
if repeat_count>0 then done_repeating;
@<Do new column segments command@>;
goto next_column;
end

@ @<Do new column segments command@>=
begin
enq_nibble(3); enq_nibble(3); enq_nibble(1); {new column segments}
enq_byte(twos_complement(num_runs));
for i←1 to num_start_stops do enq_byte(ones_complement(start_stop_vals[i]));
@!eebug
print('newcolsegs');
for i←1 to num_start_stops do print(' ',start_stop_vals[i]:1);
print_nl;
gubee@/
end

@ @<Set up for a new number of segments and |goto next_column|@>=
begin
if repeat_count>0 then done_repeating;
if num_start_stops=0 then begin
	repeat_count←1;
	goto next_column;
	end;
@<Do new column segments command@>;
for i←1 to num_start_stops do begin
	old_start_stop_vals[i]←start_stop_vals[i];
	direction[i]←down;
	end;
goto next_column;
end

@ @<Calculate |delta|, |direction| and |the_same|@>=
begin
the_same←true;
for i←1 to num_start_stops do begin
	delta[i]←start_stop_vals[i]-old_start_stop_vals[i];
	if direction[i]=down then delta[i]←-delta[i];
	if delta[i]≠0 then the_same←false;
	end;
end

@ @<Do the common case, where the segments just move a little@>=
begin
if repeat_count>0 then done_repeating;
for i←1 to num_start_stops do begin
	movement←delta[i];
	if movement<0 then begin
		movement←-movement;
		if movement<5 then begin
			enq_nibble(3); enq_nibble(3); enq_nibble(0);
			reverse_direction(direction[i]);
			@!eebug
			print(' reverse');
			gubee@/
			end;
		end;
	if movement>4 then begin
		enq_nibble(3); enq_nibble(2);
		enq_byte(ones_complement(start_stop_vals[i]));
		direction[i]←down;
		@!eebug
		print(' new',start_stop_vals[i]:1);
		gubee@/
		end
	else
		begin
		case movement of
			0: enq_nibble(0);
			1: enq_nibble(1);
			2: enq_nibble(2);
			3: begin enq_nibble(3); enq_nibble(0); end;
			4: begin enq_nibble(3); enq_nibble(1); end
			endcases;
		@!eebug
		print(' d',movement:1);
		gubee@/
		end;
	old_start_stop_vals[i]←start_stop_vals[i];
	end;
@!eebug
print_nl;
gubee@/
end

@ There's a special case if the character has no black pixels.

@<Encode empty segment@>=
begin
amf_byte(@'200);
amf_halfword(aval);
amf_halfword(cval);
@!debug
print_ln('Empty matrix');
gubed@/
end

@ Convert pixels to fixes, scaling out designsize. This is misplaced???

@<Subroutines...@>=
function amf_fix(i:integer):integer;
var r: real;
begin
r←i*(72.27/722.909)/(magnification*design_size/@"100000);
amf_fix←round(r*@"100000);
end;

@ Now we can make nibble code out of a subglyph, we have to be able to
put the subglyph-descriptor information around it properly.  We assume
that the global variable |last_subglyph| points to the previous subglyph
descriptor of the current character when this routine is called, and we
leave a pointer to the subglyph descriptor created in the same place
when we're done.  We also need |part_n_offset| to be set up to be the
hardware baseline offset for the APS.

@d tenpoint==round(10.0*@"100000/(magnification*design_size/@"100000))

@<Subroutines...@>=
procedure do_descriptor;
var descriptor: integer; {points to created subglyph descriptor}
@!nibble_address: integer; {pointer to nibble data}
@!nibble_length: integer; {length of nibble data}
begin
@!debug
print_ln('vspots=',vspots:1,' bloexp=',bloexp:1,' yoffset=',n_offset:1,
 ' partyoffset=',part_n_offset:1,' parttop=',part_top:1,' partbot=',part_bot:1);
gubed@/
nibble_address←amf_byte_no;
if no_black then @<Encode empty segment@>
else do_nibbles;
if odd(amf_byte_no) then amf_byte(0); {even APS word boundary}
nibble_length←amf_byte_no-nibble_address;
while odd(amf_byte_no div 2) do amf_byte(0); {even AMF word boundary}
descriptor←amf_byte_no;
amf_word(last_subglyph div 4);
amf_word(amf_fix(dev_x[character_code]));
amf_word(0);
amf_word(0);
amf_word(0);
amf_word(amf_fix(part_n_offset));
amf_word(tenpoint); {x mag}
amf_word(tenpoint); {y mag}
amf_word(0);
amf_word(0);
amf_word(0);
amf_word(0);
amf_word(nibble_address);
amf_word(nibble_length);
amf_word(0);
amf_word(0);
last_subglyph←descriptor;
end;

@ @<Glob...@>=
@!last_subglyph: integer; {byte number of last subglyph descriptor}
@!part_n_offset: integer; {from APS baseline to character baseline}

@ Now that we see what's going on at the lowest levels, let's hop to
the top.

@<Subroutines...@>=
function encode_char:integer;
begin
@!eebug
print_nl; @<Print the image@>;
gubee@/
last_subglyph←0;
if no_black then @<Do an empty character@>
else begin
	@<Set up |aval| and |cval|@>;
	@<Set up |vspots| and |bloexp|@>;
	if (vspots<251) and (min_n≥-64) then @<Do the character in one piece@>
	else @<Do the character in many pieces@>;
	end;
encode_char←last_subglyph div 4;
end;

@ @<Do an empty character@>=
begin
@!debug
print_ln('Empty Character');
gubed@/
aval←2*dev_x[character_code];
cval←0;
part_n_offset←0;
do_descriptor;
end

@ @<Set up |aval| and |cval|@>=
aval←2*min_m;
cval←2*(dev_x[character_code]-max_m-1);
@!debug
print_ln('aval=',aval:1,' cval=',cval:1);
gubed

@ @<Set up |vspots| and |bloexp|@>=
if min_n≥0 then begin
	bloexp←0; n_offset←0; end
else begin
	n_offset←1; bloexp←7;
	while -n_offset>min_n do begin n_offset←n_offset*2; decr(bloexp); end;
	end;
vspots←n_offset+max_n+1;

@ @<Do the character in one piece@>=
begin
part_bot←min_n; part_top←max_n; part_n_offset←0;
do_descriptor;
end

@ @<Do the character in many pieces@>=
begin {we have to do character in pieces}
bloexp←0;
part_bot←min_n;
n_offset←-part_bot;
part_n_offset←-part_bot; {bring it up to the baseline}
while -part_n_offset≤max_n do begin
	vspots←max_n+part_n_offset+1;
	if vspots>251 then vspots←251;
	part_top←part_bot+vspots-1;
	do_descriptor;
	part_bot←part_bot+vspots;
	part_n_offset←part_n_offset-vspots;
	n_offset←n_offset-vspots;
	end;
end
@* The main program.
Now we are ready to put it all together. This is where \.{GFtoAMF} starts,
and where it ends.

@p begin initialize; {get all variables initialized}
open_gf_file;
find_postamble; read_postamble;
open_gf_file;
@<Process the preamble@>;
open_amf_file;
@<Start up the |amf_file|@>
@<Translate all the characters@>;
print_nl;
@<Finish off the |amf_file|@>
print('Font had ',total_chars:1,' character');
if total_chars≠1 then print('s');
print(' altogether');
@.Font had n characters...@>
final_end:end.

@ The main program needs a few global variables in order to do its work.

@<Glob...@>=
@!a:integer; {byte number of the current command}
@!o,@!p,@!q:integer; {general purpose registers}
@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}

@ \.{GFtoAMF} looks at the preamble in order to do error checking, and to
display the introductory comment.

@<Process the preamble@>=
o←get_byte; {fetch the first byte}
if o≠pre then bad_gf('First byte isn''t start of preamble!');
@.First byte isn't...@>
o←get_byte; {fetch the identification byte}
if o≠gf_id_byte then
	error('identification byte should be ',gf_id_byte:1,
	' not ',o:1,'!');
@.identification byte should be n@>
o←get_byte; {fetch the length of the introductory comment}
print('''');
while o>0 do
	begin decr(o); print(xchr[get_byte]);
	end;
print_ln('''');

@ @<Translate all...@>=
repeat
	@<Pass |no_op|, |xxx| and |yyy| commands@>;
	if o≠post then begin
		if (o≠boc) and (o≠boc1)
		then bad_gf('byte ',cur_loc-1:1,' is not boc (',o:1,')');
@.byte n is not boc@>
		@<Pass a |boc| command@>;
		if not do_char then bad_gf('char ended unexpectedly');
@.char ended unexpectedly@>
		print(']');
		incr(total_chars);
		if (total_chars mod 10)=0 then print_nl;
		end
until o=post;

@ @<Pass |no_op|, |xxx| and |yyy| commands@>=
repeat
	a←cur_loc;
	o←get_byte; p←first_par(o);
	if eof(gf_file) then bad_gf('the file ended prematurely');
@.the file ended prematurely@>
	if o=yyy then begin @<Translate a |yyy|...@>; o←no_op; end
	else if (o≥xxx1) and (o≤xxx1+3) then begin
		@<Translate an |xxx|...@>; o←no_op;
		end;
until o≠no_op;

@ @<Pass a |boc|...@>=
a←cur_loc;
if o=boc then begin
	character_code←signed_quad;
	p←signed_quad; {ignore backpointer}
	min_m←signed_quad; max_m←signed_quad;
	min_n←signed_quad; max_n←signed_quad;
	end
else begin
	character_code←get_byte;
	p←-1;
	min_m←get_byte; max_m←get_byte;
	min_m←max_m-min_m;
	min_n←get_byte; max_n←get_byte;
	min_n←max_n-min_n;
	end;
print('[',character_code:1);

if character_code>max_char_no then abort('Character number too large');
if character_code>ec then ec←character_code;
if character_code<bc then bc←character_code;
if min_m<left_pixel then abort('Pixels beyond left limit');
if max_m>right_pixel then abort('Pixels beyond right limit');
if min_n<bot_pixel then abort('Pixels beyond bottom limit');
if max_n>top_pixel then abort('Pixels beyond top limit');
@.Pixels beyond...limit@>
@<Clear the image@>;
m←min_m;
n←max_n;
paint_switch←white;
{??? put in gf_min/max_x/y, and use for single bounds check, and
 use for extrema on character min/max_x/y ???}
@* System-dependent changes.
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{GFtoAMF} work at a particular installation.
It is usually best to design your change file so that all changes to
previous sections preserve the section numbering; then everybody's version
will be consistent with the printed program. More extensive changes,
which introduce new sections, can be inserted here; then only the index
itself will get a new section number.
@↑system dependencies@>
@* Index.
Pointers to error messages appear here together with the section numbers
where each ident\-i\-fier is used.